home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / ML_VECTB.ZIP / UTILS / MKBALLS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-03-06  |  2.1 KB  |  93 lines
  1. {$M 32000,0,0}
  2. { Program which creates the ball-tables, using BALLS8.SFT image. }
  3. { by Maple Leaf, 1996  - No comments are necessarry              }
  4. uses dosio,alloc;
  5. var f:file;
  6.     p:pointer;
  7.  
  8. procedure normalize(p:pointer);
  9. var a:word;
  10. begin
  11.   for a:=0 to 15 do
  12.     if mem[seg(p^):ofs(p^)+a]=1 then mem[seg(p^):ofs(p^)+a]:=0;
  13. end;
  14. Procedure WritePalette;
  15. var fo:file;
  16. begin
  17.   writeln('Creating palette file ...');
  18.   openforoutput(fo,'balls.pal','');
  19.   blockread(f,p^,768);
  20.   blockwrite(fo,p^,768);
  21.   close(fo);
  22. end;
  23. procedure WriteBall1;
  24. var a,b:word; xx,yy:word; fo:file;
  25. begin
  26.   write('Creating ball 1 : ');
  27.   openforoutput(fo,'redball.tab','');
  28.   xx:=16; yy:=16;
  29.   for a:=0 to 10 do begin
  30.     blockwrite(fo,xx,2);  { write x dim }
  31.     blockwrite(fo,yy,2);  { write y dim }
  32.     for b:=0 to 15 do begin
  33.       seek(f,768+(0+b)*320+a*16);
  34.       blockread(f,p^,16);
  35.       Normalize(p);
  36.       blockwrite(fo,p^,16);
  37.     end;
  38.     write('#');
  39.   end;
  40.   close(fo);
  41.   writeln;
  42. end;
  43. procedure WriteBall2;
  44. var a,b:word; xx,yy:word; fo:file;
  45. begin
  46.   write('Creating ball 2 : ');
  47.   openforoutput(fo,'blueball.tab','');
  48.   xx:=16; yy:=16;
  49.   for a:=0 to 10 do begin
  50.     blockwrite(fo,xx,2);  { write x dim }
  51.     blockwrite(fo,yy,2);  { write y dim }
  52.     for b:=0 to 15 do begin
  53.       seek(f,768+(16+b)*320+a*16);
  54.       blockread(f,p^,16);
  55.       Normalize(p);
  56.       blockwrite(fo,p^,16);
  57.     end;
  58.     write('#');
  59.   end;
  60.   close(fo);
  61.   writeln;
  62. end;
  63. procedure WriteBall3;
  64. var a,b:word; xx,yy:word; fo:file;
  65. begin
  66.   write('Creating ball 3 : ');
  67.   openforoutput(fo,'grnball.tab','');
  68.   xx:=16; yy:=16;
  69.   for a:=0 to 10 do begin
  70.     blockwrite(fo,xx,2);  { write x dim }
  71.     blockwrite(fo,yy,2);  { write y dim }
  72.     for b:=0 to 15 do begin
  73.       seek(f,768+(32+b)*320+a*16);
  74.       blockread(f,p^,16);
  75.       Normalize(p);
  76.       blockwrite(fo,p^,16);
  77.     end;
  78.     write('#');
  79.   end;
  80.   close(fo);
  81.   writeln;
  82. end;
  83. begin
  84.   p:=malloc(770);
  85.   openforinput(f,'balls8.sft','');
  86.   WritePalette;
  87.   WriteBall1;
  88.   WriteBall2;
  89.   WriteBall3;
  90.   closefile(f,'');
  91.   free(p);
  92.   Writeln('All done.');
  93. end.